home *** CD-ROM | disk | FTP | other *** search
- .title k11ini initialization and rarely used routines
- .ident /3.42/
-
-
- ; 03-Jul-84 09:34:32 Brian Nelson
- ;
- ; Copyright (C) 1984 Change Software, Inc.
- ;
- ;
- ; Remove Kermit init code and routines like SPAR and RPAR that
- ; are only called once per file transfer. Placed into overlay
- ; with K11ATR. This was done to reduce the task size a bit.
- ; Really, the only system the size is a problem is on RT11.
-
-
-
-
-
- .if ndf, K11INC
- .ift
- .include /IN:K11MAC.MAC/
- .endc
-
- .iif ndf, k11inc, .error ; missing .INCLUDE for K11MAC.MAC
- .enabl gbl
- .psect $code
-
- .macro $chkb val ,reg ,?a
- tstb @reg
- bne a
- movb val ,@reg
- a: inc reg
- .endm $chkb
-
-
-
-
-
- .sbttl initialize ourselves
-
- .iif ndf, SOH, SOH = 1
-
- kerini::call init0
- call init1
- return
-
-
- init0: mov #rwdata ,r0 ; first of all, clear all read/write
- mov #rwsize/2,r1 ; data out please
- 10$: clr (r0)+ ; for i := 1 to rwdata_size
- sob r1 ,10$ ; do data[i] := 0 ;
- mov sp ,remote ; /42/ (Moved) assume remote
- mov #1 ,blip ; assume logging all packets to tty
- clrb defdir ; /51/ Moved it
- call xinit ; /42/ Moved call forward
- mov #15 ,recdlm ; /56/ Assume CR
- mov #-1 ,setrpt ; assume we will do repeat counts
- mov sp ,doattr ; default to sending attr packets
- mov do$lng ,dolong ; /42/ We want long packets if doable
- mov sp ,doauto ; default to cecking file attributes
- mov do$exi ,exieof ; /45/ Exit on end of mcr command line
- call rparini ; default remotes sinit parameters
- call sparini ; initialize my sinit parameters
- mov #60. ,serwait ; /41/ Support SET SERVER [NO]WAIT
- mov argbuf ,argpnt ;
- mov #SOH ,recsop ; assume control A please
- mov #SOH ,sensop ; assume control A please
- mov #mx$try ,maxtry ; initialize retry limit
- mov #defchk ,chktyp ; set the default checksum type
- movb #defchk ,setsen+p.chkt ; here also please
- movb #defchk ,setrec+p.chkt ; here also please
- mov #defdly ,sendly ; init the delay for send command
- mov #1 ,chksiz ; and the default checksum size
- mov #par$no ,parity ; default the parity type please
- copyz #defprm ,#prompt ; set the prompt up
- mov sp ,con8bit ; assume 8 bits are ok for console
- tst vttype ; did xinit set this up?
- bne 20$ ; yes
- mov #tty ,vttype ; default to hardcopy console
- 20$: tst proflg ; if pro/350 then vt100
- beq 30$ ; not
- mov #vt100 ,vttype ; yes
- clr con8bit ; also say we want 7 bit data at connect
- 30$: return ; end
-
- .enabl lc
- .save
- .psect $PDATA ,D
- defprm: .asciz /Kermit-11>/
- .even
- .restore
-
-
- .enabl lsb
-
- init1:: nop ; can always patch this with a 207
- mov #200$ ,r3 ; try to open an INIT file somewhere
- 10$: tst @r3 ; any more to open up ?
- beq 100$ ; no
- calls open ,<(r3)+,#lun.ta,#text>
- tst r0 ; did the open work ?
- bne 10$ ; no, just ignore it
- 20$: mov #lun.ta ,cmdlun ; yes, setup for reading from INIT
- mov sp ,sy.ini ; a flag to use later
- 100$: return
-
- .save
- .psect $pdata
- .even
- 200$: .word 210$,220$,230$,240$,0
- 210$: .asciz /SY:KERMIT.INI/
- 220$: .asciz /LB:[1,2]KERMIT.INI/
- 230$: .asciz /SY:[1,2]KERMIT.INI/
- 240$: .asciz /KERMIT:KERMIT.INI/
- .even
- .restore
- .dsabl lsb
-
- global <xinit ,cmdlun ,lun.ta ,defchk ,defdly ,chktyp ,sendly>
- global <chksiz ,sy.ini ,parity ,setrec ,setsen ,sendat ,vttype>
- global <setrpt ,con8bit,proflg ,blip ,sensop ,recsop>
- global <argbuf,argpnt>
-
-
- .sbttl spar fill will my send-init parameters
-
-
- ; S P A R
- ;
- ; spar( %loc data )
- ;
- ; input: @r5 address of array [0..9] of char
-
- spar:: save <r0,r1,r2> ; save registers we may use
- mov #.sparsz,sparsz ; copy the send init packet size
- tst doattr ; attribute support disabled today?
- bne 10$ ; no
- tst dolong ; /42/ What about long packets
- bne 10$ ; /42/ Yep
- mov #11 ,sparsz ; No, shorten the packet up
- 10$: mov @r5 ,r2 ; point to the destiniation
- mov #senpar ,r1 ; and our local parameters
- clr snd8bit ; assume we don't need 8bit prefixing
- movb #'Y&137 ,p.qbin(r1) ; assume 'if we must do it, ok' for 8bit
- movb conpar+p.qbin,r0 ; get senders 8bit quote character
- cmpb r0 ,#'N&137 ; can the other kermit ever do 8bit ?
- bne 15$ ; no, don't bother setting the mode
- clr do8bit ; don't ever try to do it
- br 30$ ;
- 15$: cmpb r0 ,#'Y&137 ; has the other one required this mode?
- bne 20$ ; yes, set the mode up then
- cmpb parity ,#par$no ; no, but do we need to do it?
- beq 30$ ; no, don't waste the overhead
- movb #myqbin ,r0 ; yes, force this to the other side
- movb r0 ,p.qbin(r1) ; tell the other kermit we HAVE to do it
- 20$: mov sp ,snd8bit ; flag we need it for sending a file
- mov sp ,do8bit ; force 8bit prefixing then
- movb r0 ,ebquot ; and set ours to the same please
- movb r0 ,p.qbin(r1) ; /29/ fix this please
- 30$: tochar (r1)+ ,(r2)+ ; senpar.spsiz
- tochar (r1)+ ,(r2)+ ; senpar.time
- tochar (r1)+ ,(r2)+ ; senpar.npad
- ctl (r1)+ ,(r2)+ ; senpar.padc
- tochar (r1)+ ,(r2)+ ; senpar.eol
- movb (r1)+ ,(r2)+ ; senpar.qctl
- movb (r1)+ ,(r2)+ ; senpar.qbin
- movb (r1)+ ,(r2)+ ; senpar.chkt
- movb (r1)+ ,(r2)+ ; senpar.rept
- bicb #CAPA.L ,@r1 ; /42/ Assume NO long packet support
- tst dolong ; /42/ Do long packet crap?
- beq 35$ ; /42/ No
- bisb #CAPA.L ,@r1 ; /42/ Yes, insert it NOW
- 35$: bisb #CAPA.A ,@r1 ; /42/ Assume attribute support
- tst doattr ; /42/ Really do it ?
- bne 40$ ; /42/ Yes
- bicb #CAPA.A ,@r1 ; /42/ No, disable it now
- 40$: tochar (r1)+ ,(r2)+ ; senpar.capas
- tochar (r1)+ ,(r2)+ ; /42/ senpar.capas+1 (window size)
- tochar (r1)+ ,(r2)+ ; /42/ senpar.capas+2 (maxlen2)
- tochar (r1)+ ,(r2)+ ; /42/ senpar.capas+3 (maxlen1)
- clrb (r2)+ ; end
- unsave <r2,r1,r0>
- return
-
-
- fixchk::tstb setsen+p.chkt ; did the user ever set block-check?
- beq 100$ ; no
- cmpb setsen+p.chkt,#'1 ; insure that it's legit
- blo 100$
- cmpb setsen+p.chkt,#'3 ; insure that it's legit
- bhi 100$
- movb setsen+p.chkt,senpar+p.chkt
- 100$: return
-
- .sparsz == 15 ; /42/ 13 parameters to send over
-
- sparin::save <r1,r2,r3> ; save registers we may use
- mov #.sparsz,sparsz ; copy the send init packet size
- tst doattr ; attribute support disabled today?
- bne 10$ ; no
- tst dolong ; /42/ Doing long packets ?
- bne 10$ ; /42/ Yes
- mov #11 ,sparsz ; No, shorten the packet up
- 10$: mov #senpar ,r1 ; where to put them
- movb #maxpak ,(r1)+ ; maximum packet size
- movb #mytime ,(r1)+ ; my desired timeout
- movb #mypad ,(r1)+ ; how much padding
- movb #mypchar,(r1)+ ; whatever i use for padding
- movb #myeol ,(r1)+ ; line terminators (don't need it)
- movb #myquote,(r1)+ ; quoting ?
- movb #'Y&137 ,(r1)+ ; do quoting ?
- movb #mychkt ,@r1 ; /42/ checksum type
- ;- tst dolong ; /42/ Want to do long packet?
- 15$: inc r1
- movb #40 ,@r1 ; assume no repeat processing
- tst setrpt ; really say we do repeat crap?
- beq 20$ ; no
- movb #myrept ,@r1 ; default on the rest of it
- 20$: inc r1 ; fix the pointer please
- movb #mycapa ,@r1 ; we can read attributes
- tst doattr ; /42/ No attrs but do long packets?
- bne 30$ ; /42/ Leave attribute support in
- bicb #CAPA.A ,@r1 ; /42/ Remove attribute support
- 30$: tst dolong ; /42/ Long packet support desired?
- bne 40$ ; /42/ Yes, leave the bit alone
- bicb #CAPA.L ,@r1 ; /42/ No, remove support bit
- 40$: bicb #1 ,@r1 ; /42/ Insure no more capas bytes
- inc r1 ; /42/ Next please
- clrb (r1)+ ; /42/ No window size to send over
- mov #maxpak ,r3 ; /42/ Setup to break the size into
- clr r2 ; /42/ two bytes
- div #95. ,r2 ; /42/ Done
- movb r2 ,(r1)+ ; /42/ maxl1 = buffersize / 95
- movb r3 ,(r1)+ ; /42/ maxl2 = buffersize mod 95
- clrb (r1)+ ; default on the rest of it
- clrb (r1)+ ; default on the rest of it
- movb #'& ,ebquot
- unsave <r3,r2,r1>
- return
-
- global <setrec ,senpar ,setsen ,sparsz>
- global <reclng ,senlng ,dolong ,doattr ,doslid> ; /42/
- global <senwin ,recwin ,inqbuf> ; /42/
-
-
-
- .sbttl rpar read senders initialization parameters
-
- ; R P A R
- ;
- ; rpar( %loc msgpacket, %val size )
- ;
- ; input: @r5 message packet to get data from
- ; 2(r5) packet length
- ; output: REMPAR[0..20] of parameters
-
- rpar:: save <r0,r1,r2,r3,r4> ; save registers we may use
- clr r3 ; /42/ Sending long packet buffersize
- mov @r5 ,r1 ; incoming packet address
- mov 2(r5) ,r0 ; size
- mov #conpar ,r2 ; address of remotes parameters
- movb #'N ,p.qbin(r2) ; /58/ Worst case on 8bit quoting
- unchar (r1)+ ,(r2)+ ; conpar.spsiz
- dec r0 ; exit if no more data
- beq 4$ ; all done
- unchar (r1)+ ,(r2)+ ; conpar.time
- dec r0 ; exit if no more data
- beq 4$ ; all done
- unchar (r1)+ ,(r2)+ ; conpar.npad
- dec r0 ; exit if no more data
- beq 4$ ; all done
- ctl (r1)+ ,(r2)+ ; conpar.padc
- dec r0 ; exit if no more data
- beq 4$ ; all done
- unchar (r1)+ ,(r2)+ ; conpar.eol
- dec r0 ; exit if no more data
- beq 4$ ; all done
- movb (r1)+ ,(r2)+ ; conpar.qctl
- dec r0 ; exit if no more data
- beq 4$ ; all done
- movb (r1)+ ,(r2)+ ; conpar.qbin
- dec r0 ; exit if no more data
- beq 4$ ; all done
- movb (r1)+ ,(r2)+ ; conpar.chkt
- dec r0 ; exit if no more data
- beq 4$ ; all done
- movb (r1)+ ,(r2)+ ; conpar.rept
- 1$: dec r0 ; exit if no more data
- beq 4$ ; all done
- unchar (r1)+ ,@r2 ; conpar.capas
- bitb #1 ,(r2)+ ; /42/ More CAPAS to go ?
- bne 1$ ; /42/ Yes, keep getting them
- dec r0 ; /42/ Look for the Window size
- beq 4$ ; /42/ Not present
- unchar (r1)+ ,senwin ; /42/ Present, save it away please
- dec r0 ; /42/ Look for long packet size
- beq 4$ ; /42/ Anything ?
- unchar (r1)+ ,r3 ; /42/ Yes, get it please
- bicb #200 ,r3 ; /42/ Insure high bit off
- mul #95. ,r3 ; /42/ and save it
- dec r0 ; /42/ Get the next part please
- beq 4$ ; /42/ Nothing is left
- unchar (r1)+ ,r4 ; /42/ Last entry, low order of size
- bicb #200 ,r4 ; /42/ Insure high bit off
- add r4 ,r3 ; /42/ Add into senders buffersize
-
- 4$: clrb (r2)+
- mov #conpar ,r2 ; now clear parity off please in
- mov #15 ,r0 ; case an IBM system set it.
- 5$: bicb #200 ,(r2)+ ; simple
- sob r0 ,5$ ; next please
- call rparck ; /37/ insure parameters are OK
- mov #setsen ,r0 ; /43/ check to see if we need to
- mov #conpar ,r1 ; override any of the sinit stuff
- movb p.padc(r0),r2 ; /57/ Check for SET SEND PADC
- beq 6$ ; /57/ Never set
- movb r2 ,p.padc(r1) ; /57/ Set, use it
- 6$: movb p.npad(r0),r2 ; /57/ Check for SET SEND PADC
- beq 7$ ; /57/ Never set
- movb r2 ,p.npad(r1) ; /57/ Set, use it
- 7$: movb p.spsiz(r0),r2 ; if user set packetsize
- beq 10$ ; then
- movb r2 ,p.spsiz(r1) ; conpar.size := setrec.size
- 10$: movb p.eol(r0),r2 ; if user set endofline
- beq 20$ ; then
- movb r2 ,p.eol(r1) ; conpar.eol := setrec.eol
- 20$: movb p.time(r0),r2 ; if user set timeout
- beq 30$ ; then
- movb r2 ,p.time(r1) ; conpar.time := setrec.time
- 30$: tstb p.chkt(r1) ; if checksum_type = null
- bne 40$ ; then
- movb #defchk ,p.chkt(r1) ; checksum_type := default
- 40$: movb p.chkt(r1),senpar+p.chkt; setup for type of checksum used
-
- mov snd8bit ,do8bit ; in case SPAR decided WE need 8bit
- clr snd8bit ; prefixing to send a file over.
- cmpb p.qbin(r1),#'Y&137 ; was this a simple 'YES' ?
- bne 50$ ; no
- movb #myqbin ,ebquot ; yes, change it to the default '&'
- br 70$ ; and exit
- 50$: cmpb p.qbin(r1),#'N&137 ; eight bit quoting support present
- bne 60$ ; yes
- clr do8bit ; no
- br 70$
- 60$: mov sp ,do8bit ; flag for doing 8 bit prefixing then
- movb p.qbin(r1),ebquot ; and set the quote character please
- 70$: clr senlng ; /42/ Clear the write long buffer size
- tst dolong ; /42/ Really want long packets today?
- bne 75$ ; /42/ Yes
- bicb #CAPA.L ,p.capas(r1) ; /42/ No, so turn it off please
- 75$: bitb #CAPA.L ,p.capas(r1) ; /42/ Can the sender do long packets?
- beq 90$ ; /42/ No
- mov r3 ,senlng ; /42/ Yes, stuff the max buffersize
- bne 80$ ; /42/ Something is there
- ..DEFL == . + 2 ; /52/ Default
- mov #90. ,senlng ; /42/ Nothing, assume 90 (10) chars
- 80$: cmp senlng ,#MAXLNG ; /42/ Is this size bigger than buffer?
- ble 100$ ; /42/ No
- mov #MAXLNG ,senlng ; /42/ Yes, please fix it then
- br 100$ ; /43/ And exit
- 90$: tst reclng ; /43/ Ever do a SET REC PAC > 94 ?
- beq 100$ ; /43/ No
- tst infomsg ; /43/ Really dump this message?
- beq 100$ ; /43/ No
- tst msgtim ; /43/ Please, NOT for EVERY file
- bne 100$ ; /43/ Not again
- mov sp ,msgtim ; /43/ Flag we printed a warning
- calls printm ,<#1,#lmsg> ; /43/ Yes, print a warning message
- 100$: unsave <r4,r3,r2,r1,r0>
- return
-
-
- .save
- .psect $PDATA ,D
- lmsg: .ascii /%Warning - You have requested LONG packet support/<CR><LF>
- .asciz /but the other Kermit does not support this feature./<CR><LF>
- .even
- .restore
-
-
-
- .sbttl setup defaults for senders parameters and also check them
-
- rparin::save <r1,r2> ; save registers we may use
- mov #conpar ,r1 ; where to put them
- movb #maxpak ,(r1)+ ; maximum packet size
- movb #mytime ,(r1)+ ; my desired timeout
- movb #mypad ,(r1)+ ; how much padding
- movb #mypchar,(r1)+ ; whatever i use for padding
- movb #myeol ,(r1)+ ; line terminators (don't need it)
- movb #myquote,(r1)+ ; quoting ?
- movb #'Y&137 ,(r1)+ ; do quoting ?
- movb #mychkt ,(r1)+ ; checksum type
- movb #40 ,(r1)+ ; assume no repeat count processing
- clrb (r1)+ ; default on the rest of it
- clrb (r1)+ ; default on the rest of it
- clrb (r1)+ ; default on the rest of it
- clrb (r1)+ ; default on the rest of it
- clrb (r1)+ ; default on the rest of it
- mov #setsen ,r0 ; /57/ check to see if we need to
- mov #conpar ,r1 ; /57/ override any of the sinit stuff
- movb p.padc(r0),r2 ; /57/ Check for SET SEND PADC
- beq 10$ ; /57/ Never set
- movb r2 ,p.padc(r1) ; /57/ Set, use it
- 10$: movb p.npad(r0),r2 ; /57/ Check for SET SEND PADC
- beq 20$ ; /57/ Never set
- movb r2 ,p.npad(r1) ; /57/ Set, use it
- 20$: movb p.eol(r0),r2 ; /57/ if user set endofline
- beq 30$ ; /57/ then
- movb r2 ,p.eol(r1) ; /57/ conpar.eol := setrec.eol
- 30$: unsave <r2,r1>
- return
-
- rparck: mov #conpar ,r0 ; /37/ address of senders parameters
- $chkb #maxpak ,r0 ; /37/ Be defensive about the senders
- $chkb #mytime ,r0 ; /37/ parameters please
- $chkb #mypad ,r0
- $chkb #mypchar,r0
- $chkb #myeol ,r0
- $chkb #myquote,r0
- $chkb #'Y ,r0
- $chkb #mychkt ,r0
- $chkb #40 ,r0
- return ; /37/ exit to RPAR
-
-
- global <conpar ,do8bit ,setrec ,ebquot>
-
-
-
-
- .sbttl fillog log file opens/close to disk
-
- ; F I L L O G
- ;
- ; input: @r5 0 for open for read
- ; 1 for open for write
- ; 2(r5) filename
-
- .enabl lsb
-
- fillog::save <r0,r1>
- bit #log$fi ,trace ; logging file activity to disk ?
- beq 100$ ; no
- calls putc ,<#cr,#lun.lo> ; insure buffers are flushed
- mov #200$ ,r1 ; assume a header of 'writing'
- tst @r5 ; perhaps writing ?
- beq 10$ ; no
- mov #210$ ,r1 ; yes
- 10$: movb (r1)+ ,r0 ; copy the byte over
- beq 20$ ; all done
- calls putc ,<r0,#lun.lo> ; next byte pleae
- br 10$ ; next
- 20$: mov 2(r5) ,r1 ; now for the filename
- 30$: movb (r1)+ ,r0 ; copy the byte over
- beq 40$ ; all done
- calls putc ,<r0,#lun.lo> ; next byte pleae
- br 30$ ; next
- 40$: calls putc ,<#cr,#lun.lo> ; dump the record
- 100$: unsave <r1,r0> ; and exit
- return
-
-
- .save
- .psect $PDATA ,D
- 200$: .asciz /Receiving file /
- 210$: .asciz /Sending file /
- .even
- .restore
- .dsabl lsb
-
-
-
-
- .sbttl debug dump to disk
-
- ; D S K D M P
- ;
- ; input: @r5 name ('rpack' or 'spack')
- ; 2(r5) packet length
- ; 4(r5) packet type
- ; 6(r5) packet number
- ; 10(r5) packet address
-
- .enabl lsb
-
- dskdmp::save ; /42/ Save R0-R5
- sub #120 ,sp ; allocate a formatting buffer
- mov sp ,r1 ; point to it
- mov #120 ,r0 ; and clear it out
- 10$: movb #40 ,(r1)+ ; simple
- sob r0 ,10$
- mov sp ,r1 ; point back to the buffer
- mov (r5)+ ,r0 ; point to the routine name
- call 200$ ; and copy it
- mov #110$ ,r0 ; and a label ('LEN')
- call 200$ ; copy it
- mov (r5)+ ,r2 ; get the length saved
- deccvt r2,r1,#3 ; convert the length to decimal
- add #6 ,r1 ; and skip over it
- mov #120$ ,r0 ; another label ('TYP')
- call 200$ ; simple
- movb (r5)+ ,(r1)+ ; get the packet type
- movb #40 ,(r1)+ ; and some spaces
- cmpb @r1 ,#badchk ; checksum error ?
- bne 20$ ; no
- movb #'* ,-1(r1) ; yes, flag it please
- 20$: inc r5 ; point to the next arguement
- movb #40 ,(r1)+ ; and some spaces
- movb #40 ,(r1)+ ; and some spaces
- movb #40 ,(r1)+ ; and some spaces
- mov #130$ ,r0 ; and a label ('PAK')
- call 200$ ; copy it
- mov (r5)+ ,r0
- deccvt r0,r1,#3 ; and convert to decimal
- add #4 ,r1 ; now point to the end
- clrb @r1 ; make it .asciz
- mov sp ,r1 ; point back to the start
- calls putrec ,<r1,#70.,#lun.lo> ; and put out to disk now
- mov @r5 ,r3 ; /42/ May have very large packets
- mov r2 ,r4 ; /42/ Save the length please
- 30$: mov r4 ,r0 ; /42/ Assume a reasonable size
- bmi 50$ ; /42/ Anything left over to do?
- cmp r0 ,#72. ; /42/ Will the leftovers fit?
- ble 40$ ; /42/ Yes
- mov #72. ,r0 ; /42/ No
- 40$: calls putrec ,<r3,r0,#LUN.LO>; /42/ Dump a (partial) bufferfull
- add #72. ,r3 ; /42/ Move up to next partial
- sub #72. ,r4 ; /42/ And try again
- br 30$ ; /42/ Next please
- 50$: tst debug ; should we also dump to ti:?
- beq 100$ ; no
- .print r1 ; yes, dump the length and type
- .newli ; and a carrriage return
- tst r2 ; anything in the packet?
- beq 100$ ; no
- .print @r5 ,r2 ; yes, dump it
- .newlin ; and do a <cr><lf>
- 100$: add #120 ,sp ; pop the local buffer and exit
- unsave ; /42/ Unsave R5-R0
- return ; bye
-
-
- .save
- .psect $PDATA ,D
- 110$: .asciz /Length/
- 120$: .asciz /Type/
- 130$: .asciz /Paknum/
- .even
- .restore
-
-
- 200$: movb (r0)+ ,(r1)+ ; copy .asciz string to buffer
- bne 200$ ; done yet ?
- dec r1 ; yes, back up and overwrite the
- movb #40 ,(r1)+ ; null with a space
- movb #40 ,(r1)+ ; one more space for formatting
- return ; bye
-
- .dsabl lsb
-
-
- .sbttl do some logging to TI: ?
-
-
- senhdr::save <r1> ; /43/
- mov #-1 ,pcnt.n+2
- clr pcnt.n+0 ; /43/ Clear high order bits
- mov #-1 ,pcnt.t+2 ; /44/ Clear timeout stuff
- clr pcnt.t+0 ; /44/ Clear timeout stuff
- call dovt
- bcs 100$
- print #$sendh
- mov sp ,logini
- 100$: unsave <r1> ; /43/
- return
-
- rechdr::save <r1> ; /43/
- mov #-1 ,pcnt.n+2
- clr pcnt.n+0 ; /43/ Clear high order bits
- mov #-1 ,pcnt.t+2 ; /44/ Clear timeout stuff
- clr pcnt.t+0 ; /44/ Clear timeout stuff
- call dovt ; vt100 vttype type?
- bcs 100$ ; no, forget it
- print #$rech ; initial header please
- mov sp ,logini ; save we did it already
- 100$: unsave <r1> ; /43/
- return ; bye
-
-
- reclog::save <r1>
- call dolog
- bcs 100$
- mov pcnt.r+2,r1 ; check for modulo on screen updates
- clr r0 ; setup for the divide
- div blip ,r0 ; do it
- tst r1 ; any remainder left over
- bne 100$ ; yes, simply exit
- mov vttype ,r0 ; no, dispatch to the correct routine
- asl r0
- jsr pc ,@recdsp(r0)
- 100$: unsave <r1>
- return
-
-
- rectty: mov #pcnt.r ,r1 ; /43/ Pass address in r1
- call numout
- print #$delim
- mov #pcnt.s+<4*<<'N&137>-100>>,r1 ; /43/ 32 bits this time
- cmp 2(r1) ,pcnt.n+2 ; /43/ unlikely that the nak
- beq 100$ ; /43/ count would ever be > 32767
- mov 2(r1) ,pcnt.n+2 ; /43/ Use low order 16 bites
- call numout
- 100$: print #$leftm
- return
-
- recvt1: call dovt ; vt100 type?
- bcs 100$ ; no
- tst logini ; need the header?
- bne 10$ ; no
- call rechdr ; yes
- 10$: print #$pos1 ; position the cursor
- mov #pcnt.r ,r1 ; received packet count /43/
- call numout ; dump it
- mov #pcnt.s+<4*<<'N&137>-100>>,r1 ; get the sent NAK count /43/
- cmp 2(r1) ,pcnt.n+2 ; /43/ Really need to update naks?
- beq 90$ ; no
- mov 2(r1) ,pcnt.n+2 ; /43/ Stuff low order 16 bits
- call nakpos
- call numout ; print the NAK count
- 90$: call dotmo ; /44/ DO timeouts
- print #$leftm
- 100$: return
-
-
-
-
- ; for sending files, log transactions here
-
- senlog::save <r1>
- call dolog
- bcs 100$
- mov pcnt.s+2,r1 ; check for modulo on screen updates
- clr r0 ; setup for the divide
- div blip ,r0 ; do it
- tst r1 ; any remainder left over
- bne 100$ ; yes, simply exit
- mov vttype ,r0
- asl r0
- jsr pc ,@sendsp(r0)
- 100$: unsave <r1>
- return
-
-
- sentty: mov #pcnt.s ,r1 ; /43/ 32 bits now
- call numout
- print #$delim
- mov #pcnt.r+<4*<<'N&137>-100>>,r1 ; get the sent NAK count
- cmp 2(r1) ,pcnt.n+2
- beq 100$
- mov 2(r1) ,pcnt.n+2
- call numout
- 100$: print #$leftm
- return
-
- senvt1: tst logini ; need the header?
- bne 10$ ; no
- call senhdr ; yes
- 10$: print #$pos1 ; position the cursor
- mov #pcnt.s ,r1 ; /43/ 32 bits now
- call numout
- mov #pcnt.r+<4*<<'N&137>-100>>,r1 ; get the sent NAK count
- cmp 2(r1) ,pcnt.n+2
- beq 90$
- mov 2(r1) ,pcnt.n+2
- call nakpos
- call numout
- 90$: call dotmo ; /44/ Timeouts
- print #$leftm
- 100$: return
-
-
- .sbttl data for packet transfer logging
-
-
- .save
- .psect $vtdat ,ro,d,lcl,rel,con
- $sendh: .byte 33,'<
- .ascii <cr><33>/[2KPackets sent : Naks: /
- .asciz / Timeouts: /
- $rech: .byte 33,'<
- .ascii <cr><33>/[2KPackets received : Naks: /
- .asciz / Timeouts: /
- $pos1: .asciz <cr><33>/[20C/ ; goto column 20
- $pos2: .asciz <33>/[14C/ ; move over 14 please
- $leftm: .byte cr,0 ; goto left margin please
- $delim: .asciz #/#
- .even
-
- sendsp: .word sentty ,senvt1 ,senvt1 ,senvt1 ,senvt1 ,senvt1 ,senvt1
- recdsp: .word rectty ,recvt1 ,senvt1 ,senvt1 ,senvt1 ,senvt1 ,senvt1
- .assume tty eq 0
- .assume vt100 eq 1
- .restore
-
- numout: save <r0,r1,r2> ; /43/ Use $CDDMG from SYSLIB
- sub #20 ,sp ; /43/ Allocate a buffer please
- mov sp ,r0 ; /43/ Point to buffer for $CDDMG
- clr r2 ; /43/ We want leading zero and spaces
- call $cddmg ; /43/ out please
- clrb @r0 ; /43/ Make into .asciz
- mov sp ,r0 ; /43/ Reset pointer
- print r0 ; /43/ Dump the string and exit
- add #20 ,sp ; /43/ Pop buffer
- unsave <r2,r1,r0> ; /43/ Pop registers and exit
- return ; /43/ Exit
-
- global <$cddmg> ; /43/ From syslib.olb
-
-
-
- .sbttl decide what to do about logging
- .enabl lsb
-
-
- dovt: cmpb vttype,#vt100 ; a vt100 today?
- blo 90$ ; /39/ no, but allow vt220 type
- dolog: tst blip ;
- beq 90$ ; do not do this at all
- tst infomsg ; /51/ Don't do if SET QUIET
- beq 90$ ; /51/
- tst remote ; a server?
- bne 90$ ; could be
- tst xmode ; text reply?
- bne 90$ ; yes
- br 100$ ; debug is ok then
- 90$: sec
- return
- 100$: clc
- return
-
- global <blip>
-
- .dsabl lsb
-
-
- nakpos: print #npos
- return
-
- .save
- .psect $PDATA ,D
- npos: .asciz <cr><33>/[38C/ ; goto column 38
- dpos: .asciz <cr><33>/[59C/ ; /44/ For timeout count
- .even
- .restore
-
-
- dotmo: mov #pcnt.r+<4*<<'T&137>-100>>,r1 ; /44/ Get timeout count
- cmp 2(r1) ,pcnt.t+2 ; /44/ Timeout count has changed?
- beq 100$ ; /44/ No, just exit
- mov 2(r1) ,pcnt.t+2 ; /44/ Yes, update counter
- print #dpos ; /44/ Position cursor
- call numout ; /44/ Dump please
- 100$: return
-
-
-
- global <pcnt.n ,pcnt.r ,pcnt.s ,remote ,xmode ,vttype>
- global <pcnt.t>
-
-
-
- .sbttl Control A packet stats 09-Dec-86 07:46:02
- .enabl lsb
-
-
- ; This is simliar to the vms kermit's Control A status line,
- ; which is just like that used in FTP. The useful way to use
- ; this is to, in the KERMIT.INI file, add a line to modify
- ; the packet count interval: to turn it off, SET UPDATE 0,
- ; otherwise its MOD value. Typing control A will print the
- ; char count stat.
-
- cs$in:: mov #210$ ,r0 ; /56/ Save please
- mov #filein ,r1 ; /56/ Address of data to print
- br 10$ ; /56/ Common code now
- ; /56/
- cs$out::mov #200$ ,r0 ; /56/ Save please
- mov #fileout,r1 ; /56/ Address of data to print
- 10$: Message <[> ; /56/ Header for line
- call numout ; /56/ Dump the character count
- Print r0 ; /56/ Formatting
- Print #filnam ; /56/ The name of the file
- Message <]>,CR ; /56/ All done
- clr logini ; /56/ Needed if packet counting
- return ; /56/ Exit
-
- .Save ; /56/ Save current Psect
- .Psect $Pdata ,d ; /56/ Switch to data psect
- 200$: .asciz <33>/[K Characters sent for /
- 210$: .asciz <33>/[K Characters received for /
- .even ; /56/ Insure word alignment
- .Restore ; /56/ Pop old psect
- .Dsabl lsb ; /56/ All done
-
- Global <filein,fileout,filnam> ; /56/
-
-
-
- .sbttl 32 bit conversion from rsx syslib
-
-
- .GLOBL $CBTA ;Global reference
- .GLOBL $SAVRG ;Global reference
- .GLOBL $CDDMG
- $CDDMG: JSR R5,$SAVRG
- MOV R0,R3
- MOV #23420,R4
- MOV #12,R5
- TST R2
- BEQ C00024
- C00022: BIS #1000,R5
- C00024= C00022+2
- CMP (R1),R4
- BCC C00104
- MOV (R1)+,R0
- MOV (R1),R1
- DIV R4,R0
- MOV R1,-(SP)
- MOV R0,R1
- BEQ C00064
- MOV #24000,R2
- CALL C00072
- BIS #1000,R5
- MOV R0,R3
- C00064: MOV (SP)+,R1
- MOV #20000,R2
- C00072: MOV R3,R0
- BIS R5,R2
- CALL $CBTA
- BR C00116
- C00104: MOV #5,R2
- C00110: MOVB #52,(R0)+
- SOB R2,C00110
- C00116: RETURN
- .end
-